perm filename RHYTH.F4[NEW,LCS]18 blob
sn#330388 filedate 1978-01-25 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C***** SUBRS RHYTH, SETUP, MARKS, DOTS ********
C00028 ENDMK
C⊗;
C***** SUBRS RHYTH, SETUP, MARKS, DOTS ********
SUBROUTINE RHYTH
COMMON/RINP/R(10,85),POSNT(0/99)
1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,PS2,
1 RA,RDD,ITB,POSB /PTR/KWDS(1) /FRMT/FQZ(3),IREAD
1 /DPY/ST(4000),MEDIT,GO /XRN/RN(1)
1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
1 /SCX/JALPHA(30),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
1 NFLG,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
1 /ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
1 AVP2,ZX,RE,ZZ,RD,RSTX
C SEE ALSO FILLMS, SETLET AND SETUP RE. /FLM/
DIMENSION RPOS(2,100),ISU(390)
COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
1 /POSI/STFF(0/7),JJ2,POSQ /LIMIT/LIMIT,ITEM,NL,NO,IX
1 /POS/POS1,POS2 /STF/RSTFAC(0/7),RSTJ2
EQUIVALENCE (ISU,ST(3600)),(J5,JQ(2))
1, (VX(1),X),(VX(2),Y),(VX(7),Z),(RPOS,ST(3400))
1,(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
1,(VX(8),C),(VX(9),S),(VX(10),X3)
CCC DATA FIB/.75/
C FIB IS FOR PSUEDO-FIBONACCI SPACING
RSTJ3=RSTFAC(IFIX(STAFF))
NX=-1
JX=0
Y=0
NOTE=0
ICNTPT=-1
NOSET=0
JSET=0
C STUP IS NEG. IF SETUP IS NOT READY
IF(STUP)GO TO 341
IF(SET4.NE.STAFF)GO TO 70
NOSET=-1
C TO ADD MORE NOTES ON SETUP LINE. WIPES OUT P9 AT END OF SCMSS.
GO TO 270
70 DO 370 K=1,ITEM-IZ-1
C LOOKS ONLY AT THINGS BEFORE CURRENT INPUT.
J=KWDS(K)
IF(RN(J+1).GT.2)GO TO 370
IF(RN(J+2).EQ.STAFF)GO TO 270
370 CONTINUE
GO TO 170
270 ICNTPT=0
C THIS WILL CAUSE NOTES ADDED TO LINE TO HAVE NO RHYTH VAL IN P9
170 KZ=1
POS2=PS2
C GETS LAST ↑↑ POS. FROM SETUP
JSET=-1
C NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
DO 9 KX=1,100
9 IF(RPOS(2,KX).GE.0)GO TO 10
10 AVGPOS=RPOS(1,KX)
RLPOS=AVGPOS
344 KX=KX+1
IF(RPOS(2,KX).EQ.-3)GO TO 344
C**** IGNORES CLEFS (BUT NOT BARS) IN AUTOMATIC SPACING ***** 10/76
RLP2=RPOS(1,KX)
343 AVP2=RPOS(2,KX)-.001
IF(AVP2.GT.0)GO TO 341
KX=KX+1
GO TO 343
C AVERAGED AND REAL POSITIONS FROM 'SETUP'
C NEXT FOR NON-SETUP
341 DO 34 K=1,IRHY
CALL DOTS(VAL,RH,V(K),DOT)
C VAL=RHYTH. VALUE (QTR=1), RH=DENOMINATOR (QTR=4), DOT=NUM OF DOTS
C 88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
IF(RH.NE.88)GO TO 345
IF(JSET)GO TO 34
C GRACE NOTES SKIPPED IN AUTOMATIC SETUP
VAL=.125
C TAKES 1/32 SPACE FOR GRACE NOTE.
345 IF(STUP.LT.-1)VAL=PFIBX(VAL)
CCC345 IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
C STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
Y=Y+VAL
34 CONTINUE
C Y=TOTAL TIME
C A SAFEGUARD
C SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
NTC=0
C THE WORD COUNT FOR REAL NOTES.
IF(JSET)GO TO 3421
IF(POS1.LT.POS2)POSX=POS1
C SAVES IT FOR BACKUP
IF(POS1.GE.POS2)POS1=POSX
Z=POS2-POS1
ZX=Z
342 DO 1 K=1,IZ
X=R(1,K)
IF(X.LT.3.)GO TO 1
C JUMP IF NOTE OR REST
IF(X.NE.17.)GO TO 8
C JUMP IF NOT A KEY SIG.
RA=AMOD(R(5,K),100.0)
C 100+KEY SIG NUM = SIG MADE UP OF NATURALS.
RA=2.+ABS(RA)*2.0
GO TO 6
8 IF(X.NE.4.)GO TO 81
C NEXT IS FOR BAR LINES
RA=3
J=K+1
RE=R(1,J)
IF(RE.EQ.3.)RA=1.5
C A CLEF
IF(RE.EQ.18)RA=2.5
C A METER
IF(RE.NE.1)GO TO 83
IF(AMOD(R(5,J),10.).NE.0)RA=4.5
C FINDS ACCI ON NEXT NOTE.
83 IF(K.EQ.IZ)RA=0
C END OF STAFF
GO TO 6
82 RA=5
CGHB82 RA=6
GO TO 83
81 IF(X.EQ.18)GO TO 82
RA=6.
IF(K.LT.3)RA=8.
CGHB RA=7.
C FOR CLEFS
CGHB IF(K.LT.3)RA=9.
C THE FIRST CLEF IS NOT MINI
6 RA=RA*RSTJ3
C SO SPACE WILL DEPEND ON SIZE OF STAFF
Z=Z-RA
R(8,K)=RA
C STORES SPACE NUM THAT MUST BE GIVEN BACK
1 CONTINUE
C SUBTRACTS SPACE FOR CLEF OR BAR. WILL ADD BOTH LATER.
C POS1 AND Z ARE FOR RHYTHMIC SPACING
C SPACE FOR NON-NOTES
134 FORMAT(' **** MISMATCH WITH SPACING STAFF ****',F7.3/
1 F7.3,' QUARTERS IN THIS LINE.')
3421 K=0
IF(ABS(Y-RA).LE..001)GO TO 3
IF(JSET.GE.0)GO TO 3
TYPE 134,RA,Y
C LOOP TO END
3 K=K+1
C K IS COUNTER
R(7,K)=0
RE=R(1,K)
IF(RE.LE.2.)GO TO 2
RD=R(8,K)
R(8,K)=0
IF(JSET)GO TO 71
7 IF(K.EQ.IZ)POS1=POS2
IF(R(1,K-1).GT.2.)GO TO 73
IF(K.EQ.1)GO TO 73
IF(RE.EQ.4.)GO TO 73
Z=Z+RD/3.
C RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
POS1=POS1-RD/3
C THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
73 R(3,K)=POS1
72 POS1=POS1+RD
C ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
GO TO 337
C 40??? 50???? WHY NOT 100?
71 DO 74 J=KZ,80
74 IF(RE.EQ.-RPOS(2,J))GO TO 75
POS=R(3,K-1)+4
GO TO 76
75 POS=RPOS(1,J)
KZ=J+1
C FOUND SAME TYPE OF ITEM.
76 R(3,K)=POS
GO TO 337
2 JX=JX+1
21 CALL DOTS(VAL,RH,V(JX),DOT)
V(JX)=VAL
IF(RE.NE.2)GO TO 121
V(JX)=-VAL
C SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
R(7,K)=VAL
GO TO 210
121 IF(R(8,K).GE.-1.)R(9,K)=VAL
C STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
IF(RH.NE.88.)GO TO 210
CCC IF(AB.GT..05)GO TO 210
R(3,K)=-1.
R(4,K)=R(4,K)+100.
C WILL THIS BE OK WITH NOTES BELOW B3 (I.E. NEG POSITIONS.
R(7,K)=1
C FOUND A GRACE NOTE (88TH NOTE)
JZ=1
1211 IF(R(8,K+JZ).GE.0)GO TO 211
J=K+JZ
R(3,J)=-1
C FOR AUTO-SPACING AT 337
R(4,J)=R(4,J)+100.
C MAKE IT A MINI-NOTE
R(8,K)=1000.+ABS(R(4,K)-R(4,J))
C EXTEND THE STEM
JZ=JZ+1
C FOR MORE CHORD NOTES. SHOULD I CHECK FOR END (IZ)?
GO TO 1211
C ** NOT NOW ***TURNS STEM OVER. UNLESS STEM DIRECTIONS WERE FIXED.(SU/SD/)
211 IF(JZ.LE.1)R(8,K)=1000
2211 IF(JSET.GE.0)GO TO 3211
K=K+JZ-1
C POS WILL BE SET AT 336
NTC=NTC+1
C UPDATE THE COUNTER FOR IMPORTANT POSITIONS. POSNT SET AT 336
POSNT(NTC)=-1
GO TO 337
3211 VAL=.125
C IT USED TO JUMP. NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
210 RB=0
C FOR AUTOMATIC SETUP
JZ=K
C JZ WILL BE USED NEAR END
CC3634 IF(AMOD(AB,.1875).EQ.0)GO TO 122
CC T=IDOT*10
C IDOT IS NUM OF DOTS
322 IF(RE.EQ.2.)GO TO 35
T=0
IF(RH.LT.8)GO TO 522
CC IF(R(5,K).LT.10)GO TO 422
C DON'T ADD TAILS TO STEMLESS NOTE. (IT CONFUSES 'BEAMS')
T=IFIX(ALOG(RH)/0.6931472+.001)-2.0
C RH=8=1 TAIL, 16=2TAILS, ETC. THE NUM. (8,16) IS RESULT OF 2 TO THE NTH.
522 RB=0
IF(DOT.EQ.0)GO TO 422
IF(R(6,K).GE.20)RB=100
C TO SHIFT DOT DOWN 2 STEPS
422 R(7,K)=T+RB+DOT
T=0
cc422 R(7,K)=T+IDOT
C PUTS ONE OR MORE DOTS
CC GO TO 36
GO TO 22
35 R(6,K)=DOT/10.
CC35 R(6,K)=T/10.
C ADDS DOT TO REST.
CC36 RB=VAL/3.
CC IF(T.NE.1)RB=(4*VAL)/7
C TO KEEP TAIL ON DOTTED NOTE
22 POS=POS1
IF(R(6,K).GE.30)R(6,K)=R(6,K)-30
C 30 NEEDED FOR SOME CASES WITH DOTS ON CHORDS.
IF(JSET.EQ.0)GO TO 220
C NEXT IS FOR SETUP
222 IF(NOTE)GO TO 223
C FIRST TIME A NOTE IS FOUND.
NOTE=-1
POS1=RLPOS
Z=POS2-POS1
C RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
223 IF(POS1.LT.AVP2)GO TO 221
224 KX=KX+1
C???? OCT, 73 IF(NX.EQ.0)GO TO 225
L=KX
1228 IF(RPOS(2,L).NE.-3)GO TO 228
L=L+1
C IGNORE CLEFS (BUT NOT BARS) ********* 10/76
GO TO 1228
228 IF(NX)RLP2=RPOS(1,L)
NX=-1
225 IF(RPOS(2,KX-1))GO TO 227
RLPOS=RPOS(1,KX-1)
AVGPOS=AVP2
227 AVP2=RPOS(2,KX)-.001
IF(AVP2.GT.0)GO TO 223
C 0 IN RPOS=POS. OF NON-NOTE
CC****** WHY NEEDED?? 6/74 *** IF(RLP2.GE.POS1)NX=0
NX=0
CC*****↑↑↑↑ CHANGED FROM ABOVE *** 6/74
GO TO 224
221 POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
220 R(3,K)=POS
4634 IF(RE.NE.1)GO TO 44
IF(POS.EQ.POSNT(NTC))GO TO 2634
C SKIPS OTHER CHORD NOTES.
NTC=NTC+1
POSNT(NTC)=POS
C SAVES IT FOR NUMBS ABOVE NOTES, ETC.
2634 IF(RH.LT.4)GO TO 4
C JUMP IF DENOM. IS LESS THAN 4. I.E. 1/2 NOTE ETC.
44 L=K+1
IF(R(8,L).GE.0)GO TO 1634
IF(R(1,L).NE.1.)GO TO 1634
C JUMP IF NOT DOUBLE STOP
C DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
R(3,L)=R(3,K)
K=L
CC R(8,K)=0
GO TO 522
C LOOPS BACK TO PICK UP MORE CHORD NOTES
C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
4 RA=-R(6,K)
IF(RA.EQ.0)RA=-1
IF(RH.GE.2.)GO TO 144
R(5,K)=AMOD(R(5,K),10.0)
C TAKES STEM INFO OFF ANYTHING LONGER THAN 1/2 NOTES -- FOR SLUR ROUTINE.
RP=1
IF(RH.LE..5)RP=2
R(7,K)=R(7,K)+RP
C +1=WHOLE NOTE WILL PRINT +2=DBL WHL NT.
CC NOT NEEDED BECAUSE OF ABOVE. RA=-2.
144 R(6,K)=RA
GO TO 44
1634 T=POS1
RP=VAL
IF(STUP.LT.-1)RP=PFIBX(VAL)
CCC IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
C FOR PSUEDO-FIB. SPACING
POS1=RP/Y*Z+POS1
535 IF(R(1,JZ).EQ.1.)GO TO 337
RA=R(4,JZ)
C SETS REST
IF(R(8,JZ).NE.0.1)GO TO 537
T=-4
R(8,JZ)=-2
C -2 CENTERS THE SIGN UNDER THE RIGHT CONDITIONS
GO TO 536
CC537 IF(VAL.LT.2)GO TO 538
CC T=-1
CC IF(RH.LT.2)T=-2
CC IF(RH.LT.1)T=-3
C -1=HLF RST, -2=WHOLE, -3=DBL WHL RST, -4=REPEAT BAR SIGN(./.)
CC GO TO 536
537 T=IFIX(ALOG(RH)/0.6931472+.001)-2.
536 R(5,JZ)=T
CCC GO TO 337
C******* 4/74 NEW WAY TO FIND TAILS
C OMITS RESTS (REALLY???)
CCC334 R(7,JZ)=T+R(7,JZ)
337 IF(K.LT.IZ)GO TO 3
M=NTC
DO 335 K=IZ,1,-1
IF(R(3,K).GE.0)GO TO 335
IF(K.NE.IZ)GO TO 336
R(3,K)=POS2-4.
GO TO 335
336 N=K-1
1336 RA=R(3,N)
IF(RA.GT.0)GO TO 2336
N=N-1
IF(N.GT.0)GO TO 1336
C GO BACK (IF MORE GRACE NOTES.) TO FIND PREVIOUS BIG NOTE.
2336 T=R(3,K+1)
RB=T-RA
RA=4
IF(RB.LE.4)RA=RB/3.
C IF SPACE IS SMALL USE 1/3 OF IT.
RB=T-RA
C NEXT FOR GRACE NOTE CHORDS
IF(R(8,K+1).GE.0)GO TO 1335
RB=R(3,K+1)
M=M+1
1335 R(3,K)=RB
POSNT(M)=RB
335 M=M-1
K=0
45 K=K+1
C NEXT IS TO ARRANGE DOTS.
IF(R(7,K).LT.10)GO TO 451
RA=R(3,K)
DO 452 M=K+1,IZ
IF(R(3,M).NE.RA)GO TO 453
C JUMP IF NOT CHORD NOTE.
T=R(7,M)
RB=R(4,M)
IF(T.LT.100.)GO TO 452
C JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
IF(RB-R(4,M-1).NE.2)GO TO 452
IF(AMOD(RB,2.).NE.0)R(7,M)=AMOD(T,10.)
C TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
452 CONTINUE
453 K=M-1
451 IF(K.LT.IZ)GO TO 45
IF(ICNTPT)GO TO 13
DO 113 K=1,IZ
RA=R(1,K)
IF(RA.GT.2)GO TO 113
C THIS ZEROS RHYTH PARAM IF NOTES WERE ALREADY ON THIS LINE.
J=9
IF(RA.EQ.2)J=7
R(J,K)=0
113 CONTINUE
13 N=IZ
NTC=NTC+1
POSNT(NTC)=200
POSNT(0)=0
IF(IREAD)RETURN
CALL DPYSET(3,ISU,390)
CALL DPYBRT(6)
J2=STAFF
POSQ=STFF(J2)
J5=1
R4=20
C R5=0=1 STANDARD SIZE IS USED.
DO 131 K=1,NTC-1
R3=RHORZ(POSNT(K))
CALL PNUM
C GOES TO DRAW A NUMBER OVER A NOTE
J5=J5+1
IF(J5.EQ.10)J5=0
131 CONTINUE
132 CALL DPYOUT(3)
CALL SETPOG(1)
END
C SETUP ALLOWS SETING UP RHYTHMS ON DESIGNATED STAFF FOR SPACING ALL OTHERS.
SUBROUTINE SETUP
INTEGER PWDS
COMMON /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX
1 /DPY/ST(4000),MEDIT,GO /XRN/RN(1)
1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
1 ENDP,RA,RDD,ITB,POSB
DIMENSION RPOS(2,100)
EQUIVALENCE (RPOS,ST(3400))
C RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
STUP=-1
C THIS SENDS INFO TO SUBR. NOTES
IF(SET4.GT.7)RETURN
C **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
IF(ITEM.EQ.0)RETURN
JX=0
CC RNL=0
RA=0
DO 9534 K=1,ITEM
L=PWDS(K)
IF(RN(L+2).NE.SET4)GO TO 9534
RD=RN(L+1)
IF(RD.LT.5)GO TO 5
IF(RD.LT.17)GO TO 9534
5 IF(RD.GT.2)GO TO 6
RC=7
IF(RD.EQ.2)RC=5
IF(RN(L).LT.RC)GO TO 9534
M=9
IF(RD.EQ.2)M=7
IF(RN(L+M).EQ.0)GO TO 9534
C FOR OTHER NOTES ON SPACING STAFF.
IF(RN(L+8).GT.999.)GO TO 9534
C SKIPS MINI-NOTES. BUT TROUBLE IF STEMS CAUSE P8 TO BE ≤ 999.
GO TO 7
C SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
6 IF(RD.NE.3)GO TO 8
IF(RN(L).LT.3)GO TO 7
RC=RN(L+5)
IF(RC.GE.100)GO TO 7
IF(RC.GT.3)GO TO 9534
C SKIPS IF NOT A REAL CLEF (+100=MINI CLEF)
GO TO 7
8 IF(RD.NE.4)GO TO 10
IF(RN(L).GT.2)GO TO 9534
C SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
10 IF(RD.NE.2)GO TO 7
IF(RN(L).LT.5)GO TO 9534
IF(RN(L+7).EQ.0)GO TO 9534
7 JX=JX+1
RPOS(1,JX)=RN(L+3)
IF(RD.GT.2)GO TO 3
C JUMP WHEN TIME VALUES ARE IN P8
RC=RN(L+M)
C FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
277 RA=RA+RC
C SUM OF RHYTHS
GO TO 77
3 RC=-RD
77 RPOS(2,JX)=RC
C RC IS RHYTHMIC VALUE OF NOTE.
9534 CONTINUE
C NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
IF(RA.EQ.0)RETURN
C RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF.
CALL SORT2(RPOS,JX)
ENDP=200.
IF(RPOS(2,JX))ENDP=RPOS(1,JX)
DO 1 L=1,JX
1 IF(RPOS(2,L).GT.0)GO TO 4
4 RD=RPOS(1,L)
RB=ENDP-RD
C TOTAL SPACE FROM 1ST NOTE TO END OF LINE
RC=RPOS(2,L)
RPOS(2,L)=RD
C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
DO 2 K=L+1,JX
RE=RPOS(2,K)
IF(RE)GO TO 2
RD=RC/RA*RB+RD
RC=RE
RPOS(2,K)=RD
2 CONTINUE
C 1,K=REAL POS. 2,K=AVERAGED POS.
C IN RHYTH: POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
JX=JX+1
RPOS(1,JX)=ENDP
RPOS(2,JX)=ENDP
STUP=0
C THIS FOR NOTES AND RHYTH
END
SUBROUTINE MARKS(RA)
COMMON/ALF/INP(72),ML
DIMENSION MKS(14)
DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
EQUIVALENCE (MF,MKS(3)),(MH,MKS(9)),(MP,MKS(11)),(MM,MKS(5))
1,(MC,MKS(12)),(MR,MKS(13)),(MI,MKS(10)),(MS,MKS(4))
RA=99
DO 16 JM=1,72
16 IF(INP(JM))GO TO 17
C DIDN'T FIND MORE LETTERS
RETURN
17 N=INP(JM)
ML=INP(JM+1)
M=INP(JM+2)
DO 1 K=1,14
1 IF(N.EQ.MKS(K))GO TO 2
C DID NOT FIND A LETTER
RETURN
C 4=W(EDGE),5=A(CCENT),26=FE(RMATA),7=S(TACCATO),9=T(ENUTO)
C 11=D(OWNBOW), 12=U(PBOW),13=H(ARMONIC),14=PL(US),15=TH(ESIS)
C 16=AR(SIS),17=MO(RDANT)
C 18=I(NVRTD MORD), ---,20=TR(ILL), 21=TRF(LAT), 22=TRS(HARP)
C 23=TRN(ATURAL), >39=PPP, PP, CRESC., ETC.
C 25=HW (HEAVY WEDGE), 80=ACC(EL.) FICTA:5=FLAT, 2=#, 3=NAT.
C***** 20 IS OPEN
2 GO TO(120,10,12,120,4,11,15,15,15,21,12,80,81,87),K
12 IF(ML.EQ.'L')GO TO 120
C ↑↑↑ PLUS
IF(N.EQ.MF)GO TO 121
RA=42
IF(ML.NE.MP)GO TO 18
RA=41
IF(M.EQ.MP)RA=40
C FOR P, PP, PPP -- 42, 41, 40
GO TO 18
15 IF(ML.EQ.MI)GO TO 82
K=K+1
IF(ML.EQ.MKS(1))K=22
C 'HW' MAKES 25 (EVENTUALLY MAKES CLEF# 44)
120 IF(ML.EQ.MF)GO TO 88
K=K+3
8 RA=K
C YOU CAN TYPE # OR NAME OF MARK
18 DO 6 JM=1,72
N=INP(JM)
INP(JM)=' '
C BLANKS OUT USED LETTERS
IF(N.EQ.'/')RETURN
IF(N.EQ.'*')RETURN
6 IF(N.EQ.';')RETURN
4 IF(ML.EQ.'O')GO TO 20
RA=43
IF(ML.EQ.MF)RA=50
C ↑↑↑↑↑ MP, MF
GO TO 18
121 IF(ML.EQ.'E')GO TO 120
C ↑↑↑ FERMATA
RA=51
IF(ML.EQ.MF)RA=52
IF(ML.EQ.MP)RA=54
IF(M.EQ.MF)RA=53
C F, FF, FFF, FP -- 51, 52, 53, 54 --- SF=45, SFZ=92
IF(ML.NE.MI)GO TO 22
C TYPE FIF, FIS, FIN FOR FICTA flat, sharp, natural
RA=1
IF(M.EQ.MS)RA=2
IF(M.EQ.'N')RA=3
GO TO 18
22 M=NALF(ML)
IF(M)GO TO 18
IF(M.LE.5)RA=30+M
C TYPE /2 F0/6 F5/ FOR FINGERING NUMS. 0-5
GO TO 18
88 RA=45
C FOR SF AND SFZ
IF(INP(JM+2).EQ.'Z')RA=92
GO TO 18
10 IF(ML.EQ.MC)GO TO 84
IF(ML.NE.MR)GO TO 120
19 K=13
C 'R' FOR ARSIS
GO TO 120
11 IF(ML.EQ.MH)K=12
C THESIS
IF(ML.NE.MM)GO TO 110
K=60
IF(M.EQ.'E')K=58
IF(M.EQ.MS)K=59
C TM=TREMOLO,3 BEAMS=63 AT LABEL 8
C TME, TMS: 61=1 BEAM, 62=2 BEAMS
110 IF(ML.NE.MR)GO TO 120
K=17
C TR(ILL)=20 TRF(LAT)=21 TRS(HARP)=22 TRN(ATRL)=23
IF(M.EQ.MF)K=18
IF(M.EQ.MS)K=19
IF(M.EQ.'N')K=20
GO TO 120
20 K=17
GO TO 8
21 K=18
GO TO 8
80 IF(ML.EQ.'+')GO TO 85
C FOR /N1 C+ N2/ ETC. -- CRESC. AND DECRESC. LINES.
IF(ML.EQ.'-')GO TO 86
RA=70
C CRESC.
GO TO 18
85 RA=200
GO TO 18
86 RA=199
GO TO 18
87 RA=208
GO TO 18
C ↑↑↑ FOR /N1 OT N2/ 8va
81 RA=37
C RIT.
GO TO 18
82 RA=82
C DIM.
GO TO 18
84 RA=80
C ACCEL.
GO TO 18
END